home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994…tember: Reference Library / Dev.CD Sep 94.toast / Periodicals / develop / develop Issue 11 / develop 11 code / The NetWork Project / Examples (Sources) / NetSim / stdtools.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  59.8 KB  |  2,255 lines  |  [TEXT/MPS ]
  1. { stdtools.p     © Copyright G. Sawitzki, StatLab Heidelberg 1988-1992}
  2.  
  3. {To use StdTools, call gsInitToolbox once (only once!!!) at the very 
  4. beginning of your program. StdTools will do all the necessary toolbox 
  5. initialization for you. The following resources of StdTools.RSRC are
  6. vital for the operation of StdTools:
  7.  
  8.         Progress=129;            Dialog for status report.
  9.                                 The presence of this dialog is checked
  10.                                 in SetResources, called by gsInitToolbox.
  11.         StdDialog=128;            Preloaded general purpose dialog -- for 
  12.                                 free use and modification.
  13.         
  14.         OkOrCancelAlert=131;    Alert used for error handling
  15.         AbortAlert=132;            Alert used for error handling
  16.  
  17. The following resources of StdTools.RSRC are vital for the operation of 
  18. other parts of Template:
  19.  
  20.         MBarDisplayed=128;        Menubar installed by SetUpTheMenus in unit
  21.                                 Generic.
  22.         
  23. The following resources are not vital
  24.  
  25.         Ferr=128;                Stringlist with file error messages
  26.         Merr=129;                Stringlist with memory error messages
  27.         Rerr=130;                Stringlist with resource error messages
  28.  
  29. **************************************************************************
  30. Resource ids from 1 to 256 are reserved for future extensions of StdTools.
  31. The following additional resources are used so far:
  32.     OkOrCancelAlert=131;    Alert resource id
  33.     AbortAlert=132;            Alert resource id
  34.     BadConfiguration=133;    Alert resource id
  35.     LowConfiguration=134;    Alert resource id
  36.  
  37. **************************************************************************
  38.  
  39. StdTools provides a simplified access to Macintosh toolbox routines.
  40. The naming conventions of MacApp have been adopted to faciliate an
  41. easy transition to MacApp.
  42.  
  43.  
  44. Areas covered/touched:
  45.     error handling
  46.     ••• to come •••
  47.  
  48.     
  49. updating history
  50. Things to do:
  51.     support hierachical frames
  52.     unify error handling
  53.  
  54. Things done:
  55. 14  2.1992    gs    added gWaitNextEventSleep
  56. 14.12.1991    gs    added gEvent to hold current event
  57. 14.12.1991    gs    added SetZoomOutSize
  58. 14.12.1991    gs    added gCurApNamePtr
  59. 15. 8.1991  gs    added gNextEventLoopTime
  60.  1. 8.1991    gs    added gestaltVersionNr, SystemVersion in system
  61.  1. 8.1991    gs    added hasAppleEvents in system
  62. 12. 5.1991    gs    rename all 2d vars to 2dr to allow concurrent use of Graf3d
  63. 14. 2.1991  gs    added delete of old file on close/rename
  64. 26.11.1990     gs    checked for nil menuHandles
  65. 14. 2.1988  gs    undo support added
  66.  6. 2.1988    gs    file access unified, comments enhanced, queue management added    
  67. 25.11.1987    gs    multifinder support
  68. 12. 8.1987    gs    dot simplified
  69. 30. 7.1987    gs    packet initialization put first
  70. 29. 7.1987    gs    alert package put at end.
  71. 28. 7.1987    gs    alert handler concentrated.
  72. 28. 7.1987    gs    main comment added
  73. 22. 7.1987    gs    twindow/txframe added    
  74. 12. 6.1987    gs     old system structure recovered, adaptation to MPW/MacApp
  75. 15. 3.1987    gs     dialogs/comments error handler added
  76.  3. 3.1987    ur     comments cleaned up
  77. 25. 1.1987    gs     lefttrim,righttrim,StrToSF, state cleaned up
  78. 19.10.1986    gs     dialog & checkmark added
  79. 12. 9.1986    gs    iocheck parameters changed. ioresult has to be supplied.
  80.  5. 9.1986    gs    standard file routines
  81.  2. 7.1986    gs    volume access via VRefNumber. input volume is set to default and
  82.                 kept fixed throughout process.
  83.  
  84. ******************************************************************
  85. *    Routines of most common interest / to start with:
  86. *
  87. *    See
  88. *        gsInitToolBox        initializes toolbox. Has to be called 
  89. *                            before using anything else in StdTools.
  90. *        MakeAWindow         makes a window
  91. *****************************************************************
  92.  
  93.  
  94. Special objects of StdTools:
  95.  
  96.  
  97. F R A M E S        
  98.  
  99.     For scientific applications, we need windows with several "panes" and real 
  100.     world coordinates. These are implemented as "Frames". All frames belonging 
  101.     to one window share the grafport of this window. They can, however, have 
  102.     their own 2d coordinate systems. Setting to a frame will set to the port of
  103.     the window, with the origin shifted to the topleft corner of the frame.
  104.  
  105.     MacApp Note: MacApp supports scrolling, but does not support 2d coordinates.
  106.  
  107.  
  108. C O M M A N D S-- Command numbers are used to communicate commands.
  109.  
  110.     The usual command handling is to translate any command - coming from menu
  111.     selection, dialogs, application,... - to a menu number and then to pass 
  112.     this as a token. A proposed list of command codes is given at the end
  113.     of the interface. 
  114.     For Edit-menu command numbers, we must guarantee that 
  115.     <command number> - cEditBase = <appropriate number to pass to SystemEdit>.  
  116.  
  117.  
  118. T A S K   C O N T R O L
  119.  
  120.     To allow some dynamic task control, the TaskStateType is used. Extend it, 
  121.     if you can stand it. Try to keep general status information within this 
  122.     structure
  123.  
  124.  
  125. E R R O R   H A N D L I N G
  126.  
  127.     Standard error handling is done by the procedures ErrorReport and 
  128.     HandleFailure. Typical usage:
  129.     I report an MyError. If the User askes for cancel, I handle the cancel 
  130.     request generically, or try to recover
  131.     
  132.         if ErrorReport(MyError,errRecovery+msgAlert)=cancel
  133.         then             
  134.         HandleFailure(MyError,msgCancelled);
  135.     
  136.     wher MyError is on error code, typically of type OSErr.
  137.  
  138.     4.1 note: message argument is not yet evaluated. Use for now:
  139.         if ErrorReport(MyError,0)=cancel
  140.         then             
  141.         HandleFailure(MyError,0);
  142.         
  143. ErrorReport yields ok or cancel. It uses a standard string list.
  144. Format: <Token><Text>
  145. <Token>=A    Abort only
  146.             R    Abort or retry
  147. A standard dialog is invoked if no error text is given. The TaskState
  148. is always set to TaskFatal.
  149.  
  150. }
  151.  
  152.  
  153. UNIT StdTools;
  154. {© G. Sawitzki, 1986-1992}
  155. INTERFACE
  156.  
  157. {$IFC undefined Think_Pascal}
  158. USES
  159.     Types, Quickdraw, OSIntf, ToolIntf, PackIntf,SANE,GestaltEqu; { Standard Includes}
  160. {$ELSEC}
  161. USES
  162.     SANE; { Standard Includes}
  163. {$ENDC}        
  164.  
  165.  
  166. {avoid forcing units which are not really needed}
  167. {from traps:}
  168. const
  169.     _InitGraf                        = $A86E;
  170.     _Unimplemented                    = $A89F;
  171.     _GestaltDispatch                = $A0AD;
  172. {from syseq:}
  173.     CurApName                        = $0910;
  174.     Ticks                             = $16A;                   
  175.         {[GLOBAL VAR] Current number of ticks since system startup (long)
  176.            Tick count, time since boot [unsigned long]}
  177.  
  178.     {C O M M A N D S -- use these Command numbers to communicate commands.}
  179.  
  180.  
  181. {These command numbers are taken from MacApp.
  182. MacApp Note: In MacApp, not all of these are caught by MacApp. The list
  183. shows the following marks referring to MacApp:
  184.     "<!>" means MacApp catches it.
  185.     "<&>" means TEView catches it.
  186.     "<->" means the application must catch it if it is used as a
  187.           command number in any menu."}
  188.  
  189.  
  190. CONST
  191.     cEventLoopDelay=3;    {Macintosh heart beat rate: devault time interval
  192.                         to call WaitNextEvent}
  193.  
  194.     {Special command codes}
  195.             cNoCommand        =    0;     {<!> Command number representing no command}
  196.             cCantUndo        =    -1;    {<!> Passed to indicate that the command 
  197.                                     cannot be undone.}
  198.                                         
  199.     {Apple-menu commands}
  200.             cAboutApp        =    1;     {<!> "About <appname>…"}
  201.  
  202.     {File-menu filing commands}
  203.             cNew            =    10;     {<!> "New" }
  204.             cNewLast        =    19;        {(reserve a range of NEW commands)}
  205.             
  206.             cOpen            =    20;     {<!> "Open ..." (reserve a range of OPEN )}
  207.             cOpenLast        =    29;
  208.         
  209.             cSave            =    30;     {<!> "Save"}
  210.             cClose            =    31;     {<!> "Close"}
  211.             cSaveAs         =    32;     {<!> "Save as..."}
  212.             cSaveCopy        =    33;     {<!> "Save a Copy in ..."}
  213.             cRevert         =    34;     {<!> "Revert" (to previous version)}
  214.             cShowClipboard    =    35;     {<!> "Show Clipboard"/"Hide Clipboard"}
  215.             cQuit            =    36;     {<!> "Quit"}
  216.  
  217.     {Edit-menu commands}
  218.             cEditBase        =    101;     {start of standard editing commands}
  219.             cUndo            =    101;     {<!> "Undo <command>"/"Redo <command>"}
  220.             cEditSep        =    102;     {line separating UNDO from CUT}
  221.             cCut            =    103;     {<&> "Cut"}
  222.             cCopy            =    104;     {<&> "Copy"}
  223.             cPaste            =    105;     {<&> "Paste"}
  224.             cClear            =    106;     {<-> "Clear"}
  225.             cEditLast        =    cClear;
  226.         
  227.             cSelectAll        =    110;     {<&> "Select All"}
  228.         
  229.             cTyping         =    120;     {for use in a TTypingCommand}
  230.             cMouseCommand    =    121;     {generic mouse command}
  231.         
  232.     {Finder pseudo-commands: what the user selected in the finder}
  233.             cFinderNew        =    40;     {<!> selected the tool and chose "Open"}
  234.             cFinderPrint    =    41;     {<!> selected document and chose "Print"}
  235.             cFinderOpen     =    42;     {<!> selected document and chose "Open"}
  236.  
  237.     {File-menu printing commands }
  238.             cPrFileBase     =    176;     {Command numbers between cPrFileBase}
  239.             cPrFileMax        =    195;    {and cPrFileMax are to be handled by
  240.                                         documents themselfes}
  241.         
  242.             cPageSetup        =    176;     {<!> "Page Setup..."}
  243.             cPrintOne        =    177;     {<!> "Print One"}
  244.             cPrint            =    178;     {<!> "Print..."}
  245.             cPrintToFile    =    179;     {<!> "Print to file..."}
  246.             cPrintSpoolFile =    190;     {<-> "Print spooled file..."}
  247.  
  248.             cPrViewBase     =    201;     {Command numbers between cPrViewBase 
  249.             cPrViewMax        =    250;    {and cPrViewMax are to be handle by
  250.                                         a view}
  251.  
  252.             cShowBorders    =    199;     {<!> Toggle. "Show view borders"}
  253.  
  254.     {Zooming commands}        {Not being used at present}
  255.             cReduce50        =    301;     {<-> "Reduce 50%"}
  256.             cReduceToFit    =    302;     {<-> "Reduce to Fit"}
  257.             cShowFullSize    =    303;     {<-> "Show Full Size"}
  258.  
  259.  
  260.  
  261.     { T A S K   C O N T R O L --- S t a t u s  &  E r r o r management }
  262.  
  263.  
  264. Type
  265.  
  266.     TaskStateType = (     
  267.     {Status          Interpretation:                Main Event Loop action:}
  268.  
  269.     TaskFatal,         {a fatal error occured.            call CleanUp and leave/bail out}
  270.     TaskAbort,         {user asked for abort.            call CleanUp and leave/bail out}
  271.     TaskExit,        {all is done.                    call CleanUp and leave/bail out}
  272.     TaskCancel,        {user asked to cancel an action.step down a level}
  273.       TaskFinished,    {an action if finished.            pass to task to step down a level}
  274.     TaskOk,            {an action is running.            pass to task routine}
  275.     TaskIdle,        {no action is running.no task.    wait for event}
  276.     TaskNew            {no action. no task.            post menu new event}
  277.     );
  278.     
  279.     BackPhase = (BackBegin, BackContinue, BackEnd);    {if no event is pending}
  280.         {BackBegin means: going to background; BackContinue: no change; BackEnd: to foreground}
  281.         
  282.     TrackPhase = (trackPress, trackMove, trackRelease);    {not used now}
  283.     CmdNumber=Integer;    { type taken from MacApp }
  284.  
  285.  
  286. var
  287.     {we  n e v e r  want to obstruct a user. So we keep one global variable telling
  288.     when to return to the main event loop.}
  289.     
  290.     gNextEventLoopTime:  longint;    {time to call waitnextevent. Read-only. Set in
  291.                         main event loop }
  292.     gWaitNextEventSleep: longint;    {Sleep value to pass to next WaitNextEvent call.
  293.                         Should be set to the minimum of the sleep values for all handlers}
  294.                         
  295.  
  296.     {here are the methods to access this variable. These are one-liners. For speed,
  297.     they can be expanded inline.}
  298.  
  299. procedure SetEventLoopTime(maxdelay:longint);
  300.     {sets the global variable gNextEventLoopTime. Recommended valus is 3, 
  301.     corresponding to 1/20 s}
  302.     
  303. function IsEventLoopTime:boolean;
  304.     {returns true if gNextEventLoopTime has expired}
  305.     
  306.     
  307. VAR    {global variables. Do  not use too many, or you are lost when you crash}
  308.  
  309.     {**************************************************
  310.     Main information about current state of the program
  311.     **************************************************}
  312.     gCurApNamePtr: StringPtr;
  313.     gTaskState : TaskStateType; {current task state}
  314.     gErrorLatch:Integer;        {last error id reported}
  315.     gInBackground: boolean;        {true if task is running in background}
  316.  
  317.     {**************************************************
  318.     Information about the system environment
  319.     **************************************************}
  320.  
  321.     System : RECORD                {set by procedure setglobals}
  322.         FileSystem : (MFS, HFS, UnixFS);
  323.         OS : (Mac, MacPlus, Lisa, Unix);
  324.         GraficModel:(QuickDrawModel,ColorQuickDrawModel,PostscriptModel);        
  325.         gestaltVersionNr:longint;    {Gestalt manager version, or 0 if none}
  326.         SystemVersion:longint;    {lower word contains system version}
  327.         hasAppleEvents: boolean;
  328.         Rom:integer;
  329.         Machine:integer;
  330.         ScreenWidth, ScreenHeight : Integer;
  331.         DragRect, GrowRect, ZoomRect : rect;
  332.         WindowCount : integer;            {memory for makeawindow}
  333.         SFPutPoint, SFGetPoint : Point;
  334.         WNEIsImplemented: boolean;
  335.         MBarHeight:    INTEGER;    {Height of the menu bar in pixels}
  336.     END;
  337.  
  338.     {**************
  339.     Resource access
  340.     ***************}
  341.  
  342.     watchHandle,crossHandle    :    CursHandle;
  343.     gHomeResFile : integer;    {the application resource file will be noted here}
  344.     gStdDialog    : DialogPtr;    {set to point to dialog 128, if this is available}
  345.  
  346.     {***********************
  347.     Undo Support
  348.     ************************}
  349.     gUndoHandle    :     Handle;        {handle to recovery info. Must be disposable!}
  350.     gUndoType    :    ResType;    {PICT, TEXT…. Type of gUndoHandle info}
  351.     gUndoOwner    :    Ptr;        {windowptr, frameptr. Should identify document}
  352.     gUndoAction    :    CmdNumber;    {command to perform when undoing}
  353.     
  354.     {***********************
  355.     Other global information
  356.     ************************}
  357.  
  358.     {variables names adapted to UMacApp.p}    
  359.     gAppDone:        BOOLEAN;    {set this to TRUE when you want to terminate}
  360.     gCouldPrint:    BOOLEAN;    {whether Printer code is accessible}
  361.     gFinderPrinting:BOOLEAN;    {TRUE iff the Finder started just for printing}
  362.     gInitialized:    BOOLEAN;    {Set to TRUE at the end of IApplication}
  363.     gMainEventMask:    INTEGER;    {Event mask used in main event loop.}
  364.     gEvent:         EventRecord;{Recent event -- maintained by main event loop}
  365.     gMainFileType:    OSType;     {principal file type opened/printed;by default, 
  366.                                 TApplication.SFGetFilters returns a list of just this}
  367.  
  368.     gFileCount:     INTEGER;    {# files to open/print from finder; set in Init2}
  369.  
  370.     { additional state variables from MacApp. Not used in stdtools }
  371.     gPrinting:        BOOLEAN;    {true iff currently Printing}
  372.     gGotClipType:    BOOLEAN;
  373.     gPrefClipType:    ResType;
  374.     gClipClaimed:    BOOLEAN;    {Used by PerformCommand & ClaimClipboard to determine, if
  375.                                 DoIt of a cut/copy cmd fails, whether the Clipboard had
  376.                                 already been claimed by the new command or not}
  377.  
  378.     gOldScrapStuff: ScrapStuff;
  379.     gNewScrapStuff: ScrapStuff;
  380.     gSaveClip:        RgnHandle;
  381.     gSaveOrg:        Point;
  382.     gSavePort:        WindowPtr;
  383.     
  384.     gNextSpaceMsg:    LONGINT;    {time when next low space message should
  385.                                         be displayed}
  386.  
  387.  
  388. {
  389. ******************************************************************
  390. *    general initialization routine
  391. ******************************************************************
  392. }
  393.  
  394. PROCEDURE gsInitToolbox(callsToMoreMasters: INTEGER);
  395.     {Call this the very first thing in your main program.  Does the essential 
  396.     Toolbox initialization;In MacApp, if you also use the printing unit 
  397.     UPrinting, call InitPrinting just after you call InitToolbox}
  398.  
  399.  
  400.  
  401.         { a d j u s t    f o r   s c r e e n   s i z e }
  402.  
  403.  
  404. PROCEDURE CenterRect (VAR GlobR : rect;vh:vhselect);
  405. PROCEDURE CenterWindow (wptr : WindowPtr;vh:vhselect);
  406. {Center...: Center a window/rectangle/alert/dialog to center of screen}
  407.  
  408.  
  409.  
  410.  
  411.         { F I L E  A C C E S S }
  412.  
  413.         
  414.     {For more possibilities, see the file manager chapter of Inside Macintosh}    
  415.  
  416.     { ••• things to do:open/close for non-Text files}
  417. Type 
  418.     TFilePtr = ^TFileInfo;
  419.     
  420.     {channel all file identification through this record.
  421.     
  422.     NOTE: fName and fRename may be nil, or may be a handle to a string
  423.     trimmed to the actual length (less than 255 byte). In particular,
  424.     NewFile and OldFile will trim the names, Rename has undefinded effects,
  425.     and CloseFile will may it to NIL.
  426.     If you are going to use functions which might change the length of the 
  427.     names, you may want to call SetHandleSize first to set it to maximum size.}
  428.     
  429.     TFileinfo = Record    
  430.         fValid        : boolean;        {true if the record contains valid info}
  431.         fVolRefNum    : integer;        {the volume/working directory number}
  432.         fFileType    : OsType;        {'TEXT' for text files, etc.}
  433.         fName        : StringHandle;    {a handle to the actual name of the file.}
  434.         fModDate    : longint;        {modification date}
  435.         fRename        : StringHandle; {nil,or handle to requested name}
  436.         fActionToDo : integer;        {use command constants}
  437.         fDataRefNum : integer;        {HFS reference number of data}
  438.         fRsrcRefNum : integer;        {HFS reference number of resources}
  439.         fUserData    : longint;        {free for user}
  440.      end;
  441.  
  442. FUNCTION NameToInfo (namest : str255; var Fileinfo:TFileinfo):OsErr;
  443.     {Translate Name or pathname to Fileinfo}
  444.  
  445.     
  446. FUNCTION OldFile (prompt : str255;FileType : OsType) :TFileInfo;
  447.     {OldFile asks to select an existing file.FileType must be exactly four
  448.     characters.If you do not want anything special ,call .. OldFile(´´,´´).}
  449.  
  450. FUNCTION NewFile (prompt : str255;Proposal : str255) :TFileInfo;
  451.     {NewFile asks to select an exitsting, or to define a new file.
  452.     If you do not want anything special, call .. NewFile('',''); }
  453.  
  454.  
  455. PROCEDURE OpenRead (VAR Infile : text;var whichFile : TFileInfo);
  456.     {keeps default volume intact.}
  457. PROCEDURE OpenWrite (VAR outfile : text;var whichFile : TFileInfo);
  458.     {keeps default volume intact. Will create a temporary file if a file with
  459.     the requested name already exists.}
  460. PROCEDURE CloseFile(VAR outfile : text;var whichFile : TFileInfo);
  461.     {closes file, sets file type and calls rename if fRename is not NIL}
  462.     
  463.  
  464. FUNCTION FileExists (var whichFile : TFileInfo) : boolean;
  465. PROCEDURE FileCreate (var whichFile : TFileInfo);
  466. PROCEDURE FileDelete (var whichFile : TFileInfo);
  467. PROCEDURE FileRename (var whichFile : TFileInfo);
  468.  
  469.  
  470. FUNCTION  FileErrorReport(whichErr:integer;
  471.             message:Longint;var whichFile:TFileInfo):integer;    
  472.  
  473.  
  474.  
  475.  
  476.     { G R A F I C -- E x t e n s i o n s  t o   Q u i c k d r a w }
  477.  
  478. PROCEDURE focus (r : rect);
  479.     {focus drawing on r}
  480.  
  481.     
  482. PROCEDURE draw (fromx, fromy, tox, toy : integer);
  483.     { draws a linie from (fromx,fromy) to (tox,toy) }
  484.  
  485. PROCEDURE dot (h, v : integer);
  486.     { draws a dot at (h,v) }
  487.  
  488.  
  489.     { 2 d   G r a p h i c s   T y p e s  a n d   F u n c t i o n s}
  490.  
  491.  
  492. TYPE
  493.     point2dR = RECORD
  494.         x, y : real;
  495.     END;
  496.     port2dRptr = ^port2dR;
  497.     port2dR = RECORD
  498.         gport : grafptr;
  499.         viewrect : rect;
  500.         xleft, ytop, xright, ybottom     : real;    {real world coordinates}
  501.         xfact, yfact                     : real;    {factors for transformation}
  502.     END;
  503.  
  504. VAR         
  505.     theport2dR : port2dRptr;                    {current port will be noted here}
  506.  
  507. PROCEDURE setport2dR (port : port2dRptr);
  508.     {makes port the current 2dR-port and activates the corresponding Grafport}
  509. PROCEDURE viewp2dR (r : rect);
  510.     {defines r to be the viewrect of the current 2dR-Port}
  511. PROCEDURE adaptcoord (port : port2dRptr);
  512.     {sets scaling factors on the basis of the extreme values and
  513.     of the viewrect of port.}
  514.  
  515.     {Typical use:
  516.     openport2dR
  517.     setcoord
  518.     ....
  519.     viewp2dR        //viewport changed //
  520.     adaptcoord(theport2dR)   //adapt it//}
  521.  
  522. PROCEDURE setcoord (left, top, right, bottom : real);
  523.     {specifies real coordinates for viewRect}
  524.  
  525. PROCEDURE open2dRport (port : port2dRptr);
  526. PROCEDURE moveto2dR (x, y : real);
  527. PROCEDURE lineto2dR (x, y : real);
  528. PROCEDURE drawl2dR (xfrom, yfrom, xto, yto : real);
  529. PROCEDURE mark2dR (x, y : real;ch : char);
  530. PROCEDURE dot2dR (x, y : real);
  531.  
  532. PROCEDURE sel2dRwind (port : port2dRptr);
  533.     {activates and shows the Window corresponding to port}
  534.  
  535.  
  536.  
  537.  
  538.     { W i n d o w   m a n a g e m e n t  -- needs 2dR Graphics Types }
  539.     
  540.  
  541. { ••• forthcoming changes: channel all graphic access through Frames.
  542.  
  543.     main routines will be:
  544.     
  545.     FocusFrame(aFrame:FramePtr)    : 
  546.         make the port/2dR-port belonging to aFrame the active port, and
  547.         focus and clip on aFrame's rect.
  548.         
  549.     SelectFrame(aFrame:FramePtr) : make aFrames window the active, frontmost
  550.         and visible window, and do FocusFrame
  551.  
  552.     SetFrame will be deleted.
  553. }
  554.  
  555.  
  556.     {Linked lists used for subframes.}
  557. Type        
  558.     TxPtr = ^TxList;
  559.     FramePtr = ^TxFrame;
  560.  
  561.     TxList = RECORD
  562.             info : FramePtr;
  563.             next : TxPtr
  564.         END;
  565.  
  566. {Attributes supported genrically for frames}
  567.     TxFrameAttr = (    
  568.                     G2dRFrame,        {frame with 2dR coordinates - default}
  569.                     FrameWBorder    {border drawn}
  570.                     );
  571.                     
  572.     TxFrameType = SET OF TxFrameAttr;
  573.  
  574.     TxFrame = RECORD
  575.             fWindow : WindowPtr;        {to containing window}
  576.             fId : Integer;                {for consistency check only -- reserved}
  577.             fContainer : FramePtr;        {to direct container, if any}
  578.             fContentRect : Rect;        {boundary relative to fContainer or window}
  579.             fFrameList : TxPtr;            {List of contained frames}
  580.             fPicture : PicHandle;        {picture for update/recover if any}
  581.             fFrameType : TxFrameType;
  582.             CASE integer OF                {additional information. subject to change.}
  583.                 0 : (fCoordPointer : Ptr);    {will point to real world port}
  584.                 1 : (fPort : grafptr);
  585.                 2 : (f2dRPort : port2dRPtr);
  586.         END;
  587.  
  588. VAR
  589.     gTheFrame : FramePtr;                {global. currently active frame}
  590.  
  591. PROCEDURE setFrame (aFrame : FramePtr);
  592.     {sets aFrame to be the current grafic output frame. The following will 
  593.     be set:
  594.     The port and 2dR-port associated to aFrame will be made active.    
  595.     all coordinates will be set to the current frame, clipping will be 
  596.     constrained to aFrame. SetFrame does not bring the frame's window to 
  597.     the front, nor will it make the window visible if it is not already}
  598.  
  599.  
  600. FUNCTION newSubFrame (bigFrameP : FramePtr; FrameType : TxFrameType;
  601.     FrameRect : Rect) : FramePtr;
  602.     {creates a new subframe of bigFrame of type FrameType at FrameRect 
  603.     (rel. bigFrame). Makes the new frame the active one by calling setFrame}
  604.         
  605. {PROCEDURE splitFrame (aFrame : FramePtr;
  606.         count : integer;    
  607.         direction : vhselect;
  608.         FrameType : TxFrameType);}
  609.     {not yet implemented: split a frame to regular subframes.}
  610.  
  611. {
  612. ******************************************************************
  613. *    Routine of most common interest / to start with:
  614. ******************************************************************
  615. For more on window handling see the window manager chapter in
  616. inside Macintosh. For more on window usage, see the Frames… and
  617. Graf2dR… procedures in StdTools.}
  618.  
  619. PROCEDURE makeawindow (title : str255;
  620.                         width, height : integer;
  621.                         windowDefid : integer);
  622.     {makes a window of type windowDefid at default position. 
  623.     Use id=0 for standard. Use a negative number if you do not want
  624.     a goAwayBox.
  625.     Makeawindow also defines a default frame for this window.}
  626.  
  627. procedure SetZoomOutSize (window:windowptr;h,v:integer);
  628. {set the stdstate for a window}
  629. {keepscreen not yet supported}
  630.  
  631.  
  632.     { D i a l o g / M e n u - S u p p o r t }
  633.  
  634.  
  635. {For other possibilities, see the Dialog Manager and the Menu Manager
  636. Chapter of Inside Macintosh }
  637.  
  638.     {check mark support for menus}
  639.  
  640. PROCEDURE ItemCheckMark (theDialog : DialogPtr;ItemNo, ChkMark : integer);
  641.     {set check mark at ItemNo in theDialog. 0: off 1:on}
  642.  
  643. PROCEDURE ChkOnOffMItem (MenuHdl : MenuHandle;item, first, last : Integer);
  644.     {set ITEM in menu checked and all else in first..last as unchecked}
  645.  
  646. FUNCTION GetOnOffMItem (MenuHdl : MenuHandle;first, last : Integer) : integer;
  647.     {gets the first checked ITEM in menu. returns 0 if none is checked.}
  648.  
  649.  
  650.     {radio button clusters}
  651.     
  652. PROCEDURE PushRadioButton (theDlog : DialogPtr;item, first, last : integer);
  653.     {set ITEM in menu checked and all else in first..last as unchecked}
  654.  
  655. FUNCTION GetRadioButton (theDlog : DialogPtr;first, last : integer) : integer;
  656.     {gets the first checked ITEM in dialog. returns 0 if none is checked.}
  657.  
  658.  
  659.     {framing a default item}
  660.     
  661. PROCEDURE FrameItem (theDialog : DialogPtr;ItemNo : integer);
  662.     {draw a rounded corner frame around ItemNo in theDialog}
  663.  
  664.  
  665.     {functions and procedures to read or write Items in a dialog}
  666.  
  667. PROCEDURE ItemSetText (TheDialog : dialogptr;ItemNo : integer;itext : str255);
  668.     {set itext to static/edit/ctl item ItemNo}
  669.  
  670. PROCEDURE ItemGetText (TheDialog : dialogptr;ItemNo : integer;VAR itext : str255);
  671.     {get itext from static/edit/ctl item ItemNo}
  672.  
  673. FUNCTION  ItemGetReal (theDialog : DialogPtr;ItemNo : integer) : extended;
  674. PROCEDURE ItemSetReal (theDialog : DialogPtr;ItemNo : integer;Value : extended;Form : DecForm);
  675. FUNCTION  ItemGetNum (theDialog : DialogPtr;ItemNo : integer) : longint;
  676. PROCEDURE ItemSetNum (theDialog : DialogPtr;ItemNo : integer;Value : longint);
  677.  
  678.  
  679.  
  680.     { G e n e r a l   Q u e u e   M a n a g e m e n t }
  681.  
  682.  
  683.     {This is a simple associative queue for general purpose. You would
  684.     typically access a queue of this type by passing/requesting a pointer
  685.     to the information of interest.
  686.     
  687.     Note: with MPW Pascal, the you must call PLHeapInit before using
  688.     dynamic allocation. This is done in gsInitToolbox.
  689.     With MPW, the UNIV attribute can be used to overwrite Pascals
  690.     strong typing. With other compilers, you might need to delete
  691.     the UNIV option, and to add your own type casting on calling these
  692.     procedures, if you want to be able to pass typed pointers instead
  693.     of the general PTR type.}
  694.  
  695. TYPE 
  696.     tQueuePtr    = ^tQueueElem;
  697.     tQueueElem = record
  698.         infoPtr         : ptr;            
  699.         nextQElem        : tQueuePtr;
  700.     end;
  701.     
  702.     tQueueStatus    = record
  703.         first,last,current:tQueuePtr
  704.     end;
  705.  
  706. procedure QueueInit(var theStatus:  univ tQueueStatus);
  707.     {set all entries in theStatus to nil}
  708.  
  709. function AddPtr(thePtr: univ Ptr;var theQueueStatus: univ tQueueStatus):osErr;
  710.     {add the entry thePtr after Queue described by theQueueStatus}
  711.  
  712. function nextinfoPtr(var theQueueStatus: univ tQueueStatus):Ptr;
  713.     {Get an entry from current position of Queue described by theQueueStatus.
  714.     Advances pointer: first ... last .. nil.. first.. 
  715.     Does  n o t  delete queue entry}
  716.  
  717. Procedure DiscardPtr(thePtr: univ Ptr;var theQueueStatus: univ tQueueStatus);
  718.     {Discard an entry from the Queue. Does  n o t  dispose the info.
  719.     Does nothing, if entry is not found. Advances Current, if necessary}
  720.  
  721. Procedure DiscardFirst(var theQueueStatus: univ tQueueStatus);
  722.     {Special case: discard first entry in queue}
  723.  
  724.  
  725.  
  726.     { M i s c a l l a n e o u s  U t i l i t i e s}
  727.  
  728.     
  729.      {string utilities}
  730. FUNCTION lefttrim (s : str255) : str255; {trim leading blanks off string s}
  731. FUNCTION righttrim (s : str255) : str255; {trim trailing blanks off string s}
  732.  
  733.  
  734. FUNCTION PAbortFlag : boolean; {true, if "apple dot" - abort is pending.}
  735.     
  736. PROCEDURE ForgetUndo;
  737.     {clear undo info. dispose memory, if possible}
  738. FUNCTION PutUndo(info:handle;infoType:ResType;owner:ptr;cmd:cmdNumber):OsErr;
  739.     {note the info for undo. makes a copy of info}
  740. FUNCTION GetUndo(var info:handle;var infoType:ResType;
  741.         var owner:ptr;var cmd:cmdNumber):OsErr;
  742.     {returns a copy of the undo info, or NIL}
  743.     
  744. PROCEDURE setwport (window : windowptr);
  745.     { sets the grafport for window }
  746. PROCEDURE clearwindow (VAR window : windowptr);
  747.     {clear the picture associated to a window}
  748.  
  749. PROCEDURE idstamp (user : str255;VAR stampstring : str255);
  750.     {gives a standard identification string in stampstring.
  751.     stampstring is build from USER and the current time information.}
  752.  
  753.  
  754.     {standard progress report.}
  755.  
  756. PROCEDURE showprogress; {Brings a standard progress message to the screen}    
  757. PROCEDURE progressreport (item : integer;what : str255);
  758. PROCEDURE hideprogress; {hides the standard progress message}
  759.  
  760.  
  761.  
  762.             { E R R O R   H A N D L I N G }
  763.  
  764.  
  765. Const
  766.                 {Masks to identify special alert icons:}
  767.     NoIcon=-1;     {stopIcon,noteIcon,ctnIcon are define in dialog manager}
  768.     
  769.     OkOrCancelAlert=131;    {Alert resource id}
  770.     AbortAlert=132;            {Alert resource id}
  771.     BadConfiguration=133;    {Alert resource id}
  772.     LowConfiguration=134;    {Alert resource id}
  773.  
  774. var
  775.     gErrorComment: Str255;    {string passed as parameter ^3 by ErrrorReport}    
  776.  
  777.                 
  778. FUNCTION  ErrorReport(which:integer;message:Longint):integer;    
  779.     {Performs alert defined by alertId, returns user message}
  780. PROCEDURE HandleFailure(err:OSErr;message:Longint); {•• not yet ready ••}
  781.     {call ErrorAlert, and handle error condition appropriately}
  782. FUNCTION StdAlert(alertId:Integer;AlertIcon:Integer):integer;
  783.     {display the alert in a standard way; no response}
  784.     
  785.     {for file error handling, see file access functions}
  786.  
  787.     {calls the low level debugger}
  788.  
  789. procedure macsbug; inline $a9ff;
  790. procedure macsbugprint(s:str255);inline $abff;
  791.  
  792.  
  793.  
  794.  
  795. Implementation
  796.  
  797. {© G. Sawitzki, StatLab Heidelberg 1986-1991}
  798.  
  799.     {SetEventLoopTime and IsEventLoopTime must be matched.
  800.     The obvious implementation would be to use tickcounts.
  801.     However IsEventLoop is prone to be called in the middle of
  802.     user code. So we use low level Ticks for speed.}
  803.  
  804. procedure SetEventLoopTime(maxdelay:longint);
  805.     {sets the global variable gNextEventLoopTime. Recommended valus is 3, 
  806.     corresponding to 1/20 s}
  807. begin
  808.     gNextEventLoopTime:=LongIntPtr(Ticks)^+maxdelay;
  809. end;
  810.  
  811. function IsEventLoopTime:boolean;
  812.     {returns true if gNextEventLoopTime has expired}
  813. begin
  814.     IsEventLoopTime:=LongIntPtr(Ticks)^>=gNextEventLoopTime;
  815. end;
  816.  
  817.         { a d j u s t    f o r   s c r e e n   s i z e }
  818.  
  819.  
  820. PROCEDURE CenterRect{(VAR GlobR : rect;vh:vhselect)};
  821.     {Center a rectangle to center of screen}
  822. VAR    xdel, ydel: integer;
  823. BEGIN
  824.     xdel:=0;ydel:=0;
  825.     WITH GlobR,system DO
  826.         if vh=h then xdel := ((screenWidth - (right - left)) DIV 2) - left
  827.         else ydel := ((screenHeight - (bottom - top)) DIV 2) - top;
  828.     offsetRect(GlobR, xdel, ydel);
  829. END;
  830.  
  831. PROCEDURE CenterWindow;
  832.     {Center a window to center of screen}
  833. CONST
  834.     MakeFront = False;
  835. VAR
  836.     r, rbound : rect;
  837. BEGIN
  838.     if Wptr<>nil then begin
  839.         r := wptr^.portRect;
  840.         rbound := wptr^.portbits.bounds;
  841.         OffsetRect(r, -rbound.left, -rbound.top);
  842.         CenterRect(R,vh);
  843.         MoveWindow(wptr, r.left, r.top, MakeFront);
  844.     end;
  845. END;
  846.  
  847. { procedure CenterDialog (dptr : DialogPtr);}
  848. { needs no tricks, since DialogPtr=WindowPtr }
  849.  
  850.  
  851.  
  852. {Error.ipl         E R R O R   H A N D L I N G }
  853.  
  854.  
  855. procedure freezeAlert(which:integer);
  856.     {keep an alert in good position, and loaded. this should be done for all
  857.     critical alerts before the time is high.}
  858. var tempalert:AlertTHndl;
  859. begin
  860.     tempAlert:=AlertTHndl(Getresource('ALRT',which));
  861.     if tempalert<>nil then begin
  862.         hlock(Handle(tempalert));
  863.         Centerrect(tempalert^^.boundsrect,h);
  864.         couldalert(which);
  865.         hunlock(Handle(tempalert));
  866.     end;
  867. end;
  868.  
  869. Procedure HandleFailure{(err:OSErr;message:Longint)};
  870.     {call ErrorAlert, and handle error condition appropriately}
  871. begin    {•• not yet ready. message is not yet evaluated ••}
  872.     if errorReport(err,message)=ok then 
  873.     gTaskState:=TaskOk    {recover}
  874.     else {abort}
  875.     begin gappdone:=true; gTaskState:=TaskAbort; end;
  876.     gErrorLatch:=err;
  877. end;
  878.  
  879. function StdAlert{(alertId:integer; alertIcon:integer)};
  880.     {display the alert in a standard way}
  881.     
  882. var tempAlert : AlertTHndl;
  883.         i:integer;
  884.  begin 
  885.      tempAlert := AlertTHndl(GetResource('ALRT', alertId));
  886.      if tempalert=nil then
  887.      begin {Fatal:could not process alert}
  888.          sysbeep(2);gTaskState:=TaskFatal; 
  889.         stdalert:=cancel;sysbeep(2); 
  890.     end
  891.      else begin
  892.          Hlock(Handle(tempAlert));
  893.          CenterRect(tempAlert^^.boundsRect,h);
  894.          case AlertIcon of
  895.              
  896.             StopIcon:        i := StopAlert(alertId, nil);
  897.             NoteIcon:        i := NoteAlert(alertId, nil);
  898.             cautionIcon:    i := CautionAlert(alertId, nil);
  899.             otherwise         i:=Alert(alertId, nil);
  900.             end;
  901.         HUnLock(Handle(tempAlert));
  902.         StdAlert:=i;
  903.     end;
  904.  end;
  905.  
  906. function ErrorReport;
  907. const     {Resource ids for error message stringlists}
  908.     Ferr=128; 
  909.     Merr=129;
  910.     Rerr=130;
  911. var tempstr:str255;
  912.     id,index,tempi:integer;
  913.     class:char;
  914. begin 
  915.     id:=0;
  916.     index:=abs(which);
  917.     tempstr:='';
  918.  
  919.     {try to read the string}
  920.     if (index>32) and (index<=61) 
  921.   then  begin ID:=FErr; index:=index-32;end
  922.     else  if (index>107) and (index<=117) then  
  923.   begin ID:=MErr; index:=index-107;end
  924.     else
  925.      if (index>191) and (index<=196) 
  926.      then  begin ID:=RErr; index:=index-191;end;
  927.  
  928.     if id<>0 then {try to read the string}
  929.     GetIndString(tempstr,Id,index);
  930.  
  931.     if length(tempstr)=0 then begin {fake a string}
  932.         numtostring(which,tempstr);
  933.         tempstr:=concat('AOS-Error ',tempstr);
  934. end;
  935.         class:=tempstr[1];
  936.         delete (tempstr,1,1);
  937.      paramtext(tempstr,'','',gErrorComment);
  938.         if class='R' then tempi:=stdAlert(OkOrCancelAlert,StopIcon)
  939.         else tempi:=StdAlert(AbortAlert,StopIcon);
  940.  
  941.         if tempi=ok then
  942.         begin errorReport:=ok;gTaskState:=TaskFatal;
  943.         end else
  944.         begin errorReport:=cancel;gTaskState:=TaskFatal;end;
  945. end;
  946.  
  947.  
  948.  
  949.  
  950.     { I n i t i a l i s a t i o n }
  951.  
  952.  
  953. var     
  954.     progressdrec    : DialogRecord;
  955.     StdDrec           : DialogRecord;    {StdDialogPtr is public}
  956.  
  957.     ProgressDialog    : DialogPtr;    {used to hold a standard progress message}
  958.  
  959.  
  960. PROCEDURE setglobals;
  961. CONST
  962.     Rom85Loc = $28E;
  963.     FSFCBLen = $3F6;  {address of the low-memory File system global}
  964.     getwidth = 348;{width sfgetfile-dialog}
  965.     putwidth = 304;{sfpufile-Dialog}
  966.     addrMBarHeight =    $BAA;
  967.     WNETrapNum=$60;
  968.     UnImplTrapNum=$9F;
  969. VAR
  970.     RomCheck : ^integer;
  971.     HFSCheck : ^integer;
  972.     MBarCheck: ^integer;
  973.     Message:integer;
  974.     gestaltavailable: boolean;
  975.     l: longint;
  976.  
  977. {Here again we do the work Apple could have done. See IM VI, Listing 3-1}
  978. function NumToolboxTraps: Integer;
  979. begin
  980.     if NGetTrapAddress(_InitGraf,ToolTrap)=
  981.     NGetTrapAddress($AA6E,ToolTrap) then
  982.     NumToolBoxTraps:=$200
  983.     else 
  984.     NumToolBoxTraps:=$400;
  985. end;
  986.  
  987. function GetTrapType(theTrap:Integer): TrapType;
  988. const
  989.     TrapMask=$0800;
  990. begin
  991.     if BAnd(theTrap,TrapMask)>0 then
  992.         GetTrapType:=ToolTrap
  993.     else 
  994.         GetTrapType:=OsTrap;
  995. end;
  996.  
  997. function TrapAvailable(theTrap:Integer): Boolean;
  998. var
  999.     tType:TrapType;
  1000. begin
  1001.     tType:=GetTrapType(theTrap);
  1002.     if tType=ToolTrap then
  1003.     begin
  1004.         theTrap:=band(theTrap,$07FF);
  1005.         if theTrap>=NumToolboxTraps then
  1006.             theTrap:=_UnImplemented;
  1007.     end;
  1008.     TrapAvailable:=
  1009.     NGetTrapAddress(theTrap,tType)<>NGetTrapAddress(_Unimplemented,ToolTrap);
  1010. end;
  1011.  
  1012. BEGIN
  1013.     gCurApNamePtr:=StringPtr(curapname);
  1014.  
  1015.     RomCheck := Pointer(Rom85Loc);
  1016.     HFSCheck := POINTER(FSFCBLen);
  1017.     gestaltavailable := TrapAvailable(_GestaltDispatch);
  1018.     
  1019.     {multiple screen support for drag and grow 26.11.1990 1:18:50 Uhr    gs    }
  1020.  
  1021.     
  1022.     WITH system, screenbits DO
  1023.     BEGIN
  1024.         if gestaltavailable then begin
  1025.             if Gestalt(gestaltVersion, gestaltVersionNr) <> noErr 
  1026.                 then gestaltVersionNr:=0;
  1027.             if Gestalt(gestaltSystemVersion, SystemVersion) <> noErr 
  1028.                 then gestaltVersionNr:=0;
  1029.             hasAppleEvents := (Gestalt(gestaltAppleEventsAttr, l) = noErr);
  1030.             
  1031.         end else begin
  1032.             gestaltVersionNr:=0;
  1033.             SystemVersion:=0;
  1034.             hasAppleEvents := false;
  1035.         end;
  1036.         dragrect:=GetGrayRgn^^.rgnBBox;
  1037.         InsetRect(dragrect, 4, 4);    {avoid pushing windows off screen}
  1038.         dragrect.top := dragrect.top+MBarHeight;    {save space for menu bar}
  1039.  
  1040.         growrect:=dragrect;
  1041.         IF HFSCheck^ > 0 THEN     filesystem := HFS    ELSE filesystem := MFS;
  1042.                             {Unix etc  not yet checked}
  1043.         
  1044.         environs(rom,machine);
  1045.         
  1046.         IF RomCheck^ = $7FFF THEN Os := MacPlus        ELSE Os := Mac;
  1047.                             {Lisa,Unix etc  not yet checked}
  1048.                             
  1049.         IF Bitand(RomCheck^,$C000)=0 then GraficModel:=ColorQuickDrawModel
  1050.             else GraficModel:=QuickDrawModel;    {Postscript not yet implemented};        
  1051.  
  1052.                             {get the height of the menu bar (in pixel)}
  1053.         if OS=MacPlus then
  1054.         begin MBARcheck:=Pointer(addrMBarHeight); MBarHeight:=MBarCheck^;end
  1055.         else MBARHeight:=20;
  1056.  
  1057.  
  1058.         zoomrect := bounds;            {get the full screen}
  1059.         InsetRect(zoomrect, 4, 4);    {avoid pushing windows off screen}
  1060.         zoomrect.top := MBarHeight;    {save space for menu bar}
  1061.  
  1062.     
  1063.         screenwidth := bounds.right - bounds.left;
  1064.         screenHeight := bounds.bottom - bounds.top;
  1065.  
  1066.         SFGetPoint.h := (screenwidth - getwidth) DIV 2; SFGetPoint.v := 50;
  1067.         SFPutPoint.h := (screenwidth - Putwidth) DIV 2; SFPutPoint.v := 50;
  1068.  
  1069.         windowcount := 0;
  1070.         
  1071.         {is wait next event implemented ?}
  1072.         WNEIsImplemented:=
  1073.         NGetTrapAddress(WNETrapNum,ToolTrap) <> 
  1074.                                 NGetTrapAddress(UnimplTrapNum,ToolTrap);
  1075.     END;{system,screenbits}
  1076.  
  1077.     gTaskState:=TaskOk;
  1078.     gErrorLatch:=noErr;
  1079.     gAppDone:=false;
  1080.     
  1081.     gCouldPrint:=false;
  1082.     CountAppFiles(Message,gFileCount);
  1083.     gFinderPrinting:=(message=appPrint);
  1084.     
  1085.     gInitialized := FALSE;    {will be set TRUE in IApplication}
  1086.     gMainEventMask:=everyEvent;
  1087.  
  1088.     gHomeResFile:=CurResFile;
  1089.  
  1090.     gInBackground:=FALSE;
  1091.     gPrinting:=false;
  1092.     gUndoHandle:=nil;
  1093.     ForgetUndo;            {reset other entries of undo memory}
  1094. END;
  1095.  
  1096. procedure busyinstall; {install the busy cursor -- not yet}
  1097. begin
  1098. end;
  1099.  
  1100. procedure setResources;
  1101.     {setup resources for Message/error handling. standalone only}
  1102. label 999;
  1103. const 
  1104.     cProgressid = 129;    { resource of  progressdialog} 
  1105.     cStdid =128;        { resource of  std dialog} 
  1106. var    progressDLOG:DialogTHndl;
  1107.     tempstr:str255;
  1108.     temptype:ResType;
  1109.     TempId:integer;
  1110. begin
  1111.     ProgressDialog := NIL; {fail-save. save way to read it here ?}
  1112.     progressDLOG:=DialogTHndl(GetResource('DLOG',cProgressid));
  1113.     if ResError<>noErr then goto 999;
  1114.     
  1115.     getResInfo(Handle(progressDLOG),tempid,temptype,tempstr);
  1116.     if (ResError<>NoErr) or (tempstr<>'Progress') then goto 999;
  1117.     {hope it is ok}
  1118.     progressdialog:=getnewdialog(cProgressid,@progressDREC,pointer(-1));
  1119.     Centerwindow(windowptr(progressdialog),h);
  1120.     coulddialog(cProgressid);
  1121.     releaseResource(Handle(progressDLOG));
  1122.  
  1123.     gStdDialog:=getnewdialog(cStdid,@StdDREC,pointer(-1));
  1124.     if resError<>NoErr then gStdDialog:=nil
  1125.     else begin
  1126.         Centerwindow(windowptr(gStdDialog),h);
  1127.         coulddialog(cStdid);
  1128.     end;
  1129.     
  1130.     freezeAlert(131);
  1131.     freezeAlert(132);
  1132.  
  1133.     999:if progressDialog=NIL then {resource file missing}
  1134.     begin
  1135.         moveto(100,100);
  1136.         drawstring('•••• StdTools.RSRC Resources missing ••••');
  1137.         sysbeep(100);
  1138.         exittoshell;
  1139.     end;
  1140.  
  1141.     watchHandle:=getCursor(watchCursor);
  1142.     hNoPurge(Handle(watchHandle));
  1143.     crossHandle:=getCursor(crossCursor);
  1144.     hNoPurge(Handle(crossHandle));
  1145. end;
  1146.  
  1147. procedure gsInitToolbox;
  1148. const        {for dynamic heap management in MPW Pascal}
  1149.     cSizeHeap=$4000;
  1150.     cHeapDelta=$4000;
  1151.     cAllowNonCont=true;
  1152.     cForDispose=true;
  1153. var     
  1154.     applZone:        THz;
  1155.     oldMoreMast:    INTEGER;
  1156.  
  1157. begin
  1158.  
  1159.     InitGraf(@thePort);
  1160.     InitFonts;
  1161.     InitWindows; {creates a non-relocatable for the WM port}
  1162.     FlushEvents(everyEvent - diskMask, 0);
  1163.     InitMenus;
  1164.     TEInit;
  1165.     InitDialogs(NIL);
  1166.     InitCursor;
  1167.     {    SetStackSpace(stacksize);-- take from MacApp Uobj if necessary}
  1168.     MaxApplZone;
  1169.  
  1170.     {****this part should be in main segment****}
  1171.  
  1172.     { Here is a trick - Stolen from MacApp- sugested by Jerome C. }
  1173.     applZone := ApplicZone;
  1174.     oldMoreMast := applZone^.moreMast;
  1175.     applZone^.moreMast := oldMoreMast * callsToMoreMasters;
  1176.     MoreMasters;
  1177.     applZone^.moreMast := oldMoreMast;
  1178.  
  1179.     {for dynamic heap management in MPW Pascal}
  1180.     {    PLHeapInit(cSizeHeap,cHeapDelta,NIL,cAllowNonCont,cForDispose);}
  1181.     {****this part could go to a temporary segment****}
  1182.     SetGlobals;
  1183.     SetResources;
  1184.     BusyInstall;    
  1185. end;
  1186.  
  1187.  
  1188.  
  1189.  
  1190.  
  1191. {File.ipl: F I L E   T O O L S   P A C K A G E }
  1192.  
  1193.  
  1194. { special file error handlers }
  1195.  
  1196. function FileErrorReport;
  1197. begin
  1198.     gErrorComment:=whichFile.fname^^;
  1199.     FileErrorReport:=ErrorReport(whichErr,message);
  1200. end;
  1201.  
  1202. procedure HandleFileError(whichErr:integer;whichfile:TFileInfo);
  1203. var myerr:integer;
  1204. begin
  1205.     if whicherr=noerr then myerr:=FlushVol(NIL,whichFile.fVolRefNum)
  1206.     else myerr:=whicherr;
  1207.     if myerr<>noerr then myerr:=fileErrorReport(myerr,0,whichfile);
  1208. end;
  1209.  
  1210.  
  1211. { conversion routines }
  1212.  
  1213. Procedure ReplyToInfo (var Reply: SFReply;var Fileinfo:TFileinfo);
  1214. begin
  1215.     with FileInfo do 
  1216.     begin 
  1217.         fValid:=Reply.good;
  1218.         fVolRefNum:=Reply.vRefNum;
  1219.         fFileType:=Reply.ftype;
  1220.         fName:=NewString(Reply.fName);
  1221.         fModDate:=0;
  1222.         fRename:=nil;
  1223.     end;
  1224. end;
  1225.  
  1226. Procedure InfoToReply (var Fileinfo:TFileinfo;var Reply: SFReply);
  1227. begin
  1228.     with FileInfo do 
  1229.     begin 
  1230.         Reply.good:=fValid;
  1231.         Reply.copy:=(fRename<>nil);
  1232.         Reply.ftype:=fFileType;
  1233.         Reply.vRefNum:=fVolRefNum;
  1234.         Reply.version:=0;
  1235.         Reply.fName:=fName^^;
  1236.     end;
  1237. end;
  1238.  
  1239.  
  1240. FUNCTION NameToInfo {(namest : str255; var Fileinfo:TFileinfo):OsErr};
  1241. VAR
  1242.     volname : str255;
  1243.     filename : str255;
  1244.     saveVol,VolRef, i : integer;
  1245.     myerr : oserr;
  1246. BEGIN
  1247.     filename:=lefttrim(righttrim(namest)); {discard blank garbage}
  1248.     volname := '';
  1249.     NameToInfo:=NoErr; {default}
  1250.     
  1251.     i := pos(':', namest);
  1252.     if i>0 then     {separate filename and volname}
  1253.     begin
  1254.         i:=length(filename);
  1255.         while filename[i]<>':' do i:=pred(i); {find last :}
  1256.         volname := copy(filename, 1, i);
  1257.         filename := copy(filename, i + 1, length(filename) - i);
  1258.     END;
  1259.  
  1260.     myErr := getVol(Nil, saveVol);  VolRef:=saveVol;
  1261.  
  1262.     IF length(volname) <> 0 THEN
  1263.     BEGIN    {translate volname to VRefNum}
  1264.         myErr := SetVol(@volname, 0);        {add error check&HFS support!}
  1265.         if myerr=noErr then                
  1266.         myErr := getVol(@volname, VolRef) else NameToInfo:=myErr;
  1267.     END;
  1268.  
  1269.     WITH Fileinfo DO
  1270.     BEGIN
  1271.         fValid := (myErr = noErr);
  1272.         fRename := Nil;
  1273.         fVolRefNum := VolRef;
  1274.         fName := NewString(filename);
  1275.         fModDate:=0;
  1276.         fFileType:='????';
  1277.     END;
  1278.     myErr := setVol(NIL, SaveVol);
  1279. END;
  1280.  
  1281.  
  1282. {OldFile asks to select an exitsting file. FileType must be exactly four}
  1283. {characters. If you do not want anything special, call .. OldFile('','        '); }
  1284.  
  1285. FUNCTION OldFile;
  1286. CONST
  1287.     SFGetAll = -1;
  1288. VAR
  1289.     typelist : sftypelist;
  1290.     NrTypes : integer;
  1291.     tempReply : SFReply;
  1292.     Helpfi:TFileinfo;
  1293. BEGIN
  1294.     typelist[0] := FileType;
  1295.     IF FileType = '    ' THEN
  1296.     NrTypes := SFGetAll
  1297.     ELSE
  1298.     NrTypes := 1;
  1299.        sfgetfile(System.SFGetPoint, prompt, NIL, NrTypes, typelist, NIL, tempReply);
  1300.     ReplyToinfo(tempReply,Helpfi);
  1301.     oldFile:=Helpfi;
  1302. END;{OldFile}
  1303.  
  1304.  
  1305. {NewFile asks to select an exitsting, or to define a new file.}
  1306. {If you do not want anything special, call .. NewFile('',''); }
  1307.  
  1308. FUNCTION NewFile;
  1309. VAR
  1310.     tempReply : SFReply;
  1311.     Helpfi:TFileinfo;
  1312. BEGIN
  1313.     SFPutFile(System.SFPutPoint, prompt, Proposal, NIL, tempReply);
  1314.     ReplyToinfo(tempReply,Helpfi);
  1315.     newFile:=Helpfi;
  1316. END;{NewFile}
  1317.  
  1318.  
  1319. {FileExists }
  1320. FUNCTION FileExists;
  1321. VAR    fndrinfo : Finfo;
  1322. BEGIN
  1323.     WITH whichFile DO
  1324.     BEGIN
  1325.         IF NOT fValid THEN fileExists := false
  1326.         ELSE fileExists := (getFinfo(fname^^, fVolRefNum, fndrinfo) = NoErr);
  1327.     END;{with}
  1328. END;
  1329.  
  1330.  
  1331. PROCEDURE FileCreate;
  1332. CONST    NoCreator = '    ';
  1333. BEGIN
  1334.     WITH whichFile DO
  1335.     HandleFileError(create(fname^^, fVolRefNum, NoCreator, fFiletype),whichFile);
  1336. END;
  1337.  
  1338.  
  1339. PROCEDURE FileDelete;
  1340. BEGIN
  1341.     WITH whichFile DO
  1342.     HandleFileError(FSDelete(fname^^, fVolRefNum),whichfile);
  1343. END;
  1344.  
  1345.  
  1346. PROCEDURE FileRename;
  1347. BEGIN
  1348.     WITH whichFile DO begin
  1349.     if (fname<>nil) and (fRename<>nil) then
  1350.         HandleFileError(Rename(fname^^, fVolRefNum, fRename^^),whichfile);
  1351.     end; {with}
  1352. END;
  1353.  
  1354. { To do: is there a unified way to open Text- or other files, which works
  1355. for all compilers ?}
  1356.  
  1357. PROCEDURE OpenWrite;
  1358.     {keeps default volume intact}
  1359. VAR    tempname:str255;
  1360.     tempPtr:stringPtr;
  1361.     oldvolref : integer;
  1362.     fndrInfo : Finfo;
  1363.     myerr:integer;
  1364. BEGIN
  1365.     WITH whichfile DO
  1366.     BEGIN
  1367.         IF FileExists(whichFile) THEN
  1368.         begin {needs rename}
  1369.             fRename:=fName;
  1370.             tempPtr:=@tempname;
  1371.             fname:=@tempPtr;
  1372.             hlock(Handle(fRename));
  1373.                 repeat    {try to find an unused temporary file name}
  1374.                     idStamp(fRename^^,tempname);
  1375.                     if length(tempName)>31 then 
  1376.                         tempname:=copy(tempname,length(tempName)-31,31);
  1377.                 until (not fileExists(whichFile)) or PAbortFlag;
  1378.             hunlock(Handle(fRename));
  1379.             fName:=NewString(tempName);
  1380.         end;
  1381.         
  1382.         if gTaskState<>TaskFatal then FileCreate(whichFile);
  1383.         if gTaskState<>TaskFatal then begin
  1384.             WITH whichfile DO
  1385.             BEGIN
  1386.                 myerr:= getfinfo(fname^^, fVolRefNum, fndrinfo);
  1387.                 fndrinfo.fdtype := fFileType;
  1388.                 if myerr=noerr then myerr:= Setfinfo(fname^^, fVolRefNum, fndrinfo);
  1389.             END;
  1390.  
  1391.             if myerr=noerr then myerr:= getvol(NIL, oldvolref); {not old}
  1392.             IF gTaskState = TaskOk THEN
  1393.             if myerr=noerr then myerr:= setvol(NIL, whichfile.fVolRefNum); {just for crazy TML file handling}
  1394.             IF gTaskState = TaskOk THEN
  1395.             BEGIN
  1396.                 rewrite(OutFile, fname^^);
  1397.                 if myerr=noerr then myerr:= setvol(NIL, oldvolref);                    {reset it}
  1398.             END;
  1399.         END;{with}
  1400.         HandleFileError(myerr,whichfile);
  1401.     end;{if gTaskState<>TaskFatal then }
  1402. END;
  1403.  
  1404.  
  1405. PROCEDURE OpenRead;
  1406.     {keeps default volume intact}
  1407. VAR
  1408.     oldvolref : integer;
  1409.     myerr:integer;
  1410. BEGIN
  1411.     WITH whichfile DO
  1412.     BEGIN
  1413.         myerr:= getvol(NIL, oldvolref); {not old}
  1414.         if myerr=noerr then myerr:= setvol(NIL, whichfile.fVolRefNum); 
  1415.         {just for crazy TML file handling}
  1416.         IF myerr=noerr THEN
  1417.         BEGIN
  1418.             reset(Infile, fname^^);
  1419.              if myerr=noerr then myerr:= setvol(NIL, oldvolref);    {reset it}
  1420.         END;
  1421.     END;{with}
  1422.     HandleFileError(myerr,whichfile);
  1423. END;
  1424.  
  1425. PROCEDURE CloseFile(VAR outfile : text;var whichFile : TFileInfo);
  1426. var fndrinfo:Finfo;
  1427.     myErr:integer;
  1428. begin
  1429.     close(outfile);
  1430.     
  1431.     {adjust type and creator}
  1432.     WITH whichfile DO
  1433.             BEGIN
  1434.                 myerr:= getfinfo(fname^^, fVolRefNum, fndrinfo);
  1435.                 fndrinfo.fdtype := fFileType;
  1436.                 if myerr=noerr then myerr:= Setfinfo(fname^^, fVolRefNum, fndrinfo);
  1437.             END;
  1438.  
  1439.     HandleFileError(myerr,whichfile);    {14.2.1991 10:04:46 Uhr    gs    }
  1440.     if whichfile.fRename<>Nil then
  1441.         BEGIN
  1442.             WITH whichfile DO
  1443.                 if getFinfo(fRename^^,fVolRefNum,fndrinfo)=noErr then {old file exists}
  1444.                 HandleFileError(FSDelete(fRename^^,fVolRefNum),whichfile); {delete old file}
  1445.             FileRename(whichFile);
  1446.         END;
  1447.  
  1448. end;
  1449.  
  1450.  
  1451. { G R A F I C S }
  1452.  
  1453.  
  1454. PROCEDURE focus {(r : rect)};
  1455. {focus drawing on r}
  1456.     VAR
  1457.         dh, dv : integer;
  1458. BEGIN
  1459.     dh := thePort^.portrect.left - r.left;
  1460.     dv := thePort^.portrect.top - r.top;
  1461.     setorigin(dh, dv);
  1462.     offsetrect(r, -r.left, -r.top);
  1463.     cliprect(r);
  1464. END;
  1465.  
  1466.  
  1467.  
  1468.  
  1469. PROCEDURE draw;
  1470. BEGIN
  1471.     moveto(fromx, fromy);
  1472.     lineto(tox, toy);
  1473. END;
  1474.  
  1475. PROCEDURE setport2dR;           {(port:port2dRptr)}
  1476. BEGIN
  1477.     theport2dR := port;
  1478.     setport(theport2dR^.gport);
  1479. END;
  1480.  
  1481. PROCEDURE viewp2dR;        {(r:rect)}
  1482. BEGIN
  1483.     theport2dR^.viewrect := r;
  1484. END;
  1485.  
  1486. PROCEDURE adaptcoord;          {(port:port2dRptr)}
  1487. BEGIN
  1488.     WITH port^ DO
  1489.     BEGIN
  1490.         xfact := (viewrect.right - viewrect.left) / (xright - xleft);
  1491.         yfact := (viewrect.bottom - viewrect.top) / (ybottom - ytop);
  1492.     END;
  1493. END;
  1494.  
  1495. PROCEDURE setcoord;         {left, top, right, bottom : real}
  1496. BEGIN
  1497.     WITH theport2dR^ DO
  1498.     BEGIN
  1499.         xleft := left;
  1500.         ytop := top;
  1501.         xright := right;
  1502.         ybottom := bottom;
  1503.         adaptcoord(theport2dR);
  1504.     END;
  1505. END;
  1506.  
  1507. PROCEDURE open2dRport;   {port : port2dRptr}
  1508. BEGIN
  1509.     theport2dR := port;
  1510.     port^.gport := theport;
  1511.     port^.viewrect := theport^.portrect;
  1512.     WITH theport^.portrect DO
  1513.     setcoord(left, top, right, bottom);
  1514. END;
  1515.  
  1516. PROCEDURE moveto2dR;         {x, y : real}
  1517. BEGIN
  1518.     WITH theport2dR^ DO
  1519. moveto(round((x - xleft) * xfact + viewrect.left), round((y - ytop) * yfact + viewrect.top));
  1520. END;
  1521.  
  1522. PROCEDURE lineto2dR;         {x, y : real}
  1523. BEGIN
  1524.     WITH theport2dR^ DO
  1525. lineto(round((x - xleft) * xfact + viewrect.left), round((y - ytop) * yfact + viewrect.top));
  1526. END;
  1527.  
  1528. PROCEDURE drawl2dR;             {xfrom, yfrom, xto, yto : real}
  1529. BEGIN
  1530.     moveto2dR(xfrom, yfrom);
  1531.     lineto2dR(xto, yto);
  1532. END;
  1533.  
  1534. PROCEDURE mark2dR;             {x, y : real; ch : char}
  1535. BEGIN
  1536.     moveto2dR(x, y);
  1537.     drawchar(ch);
  1538. END;
  1539.  
  1540.  
  1541. { dot-proceduren für scatterplots }
  1542.  
  1543. {support procedures}
  1544.  
  1545. PROCEDURE dotHere;
  1546. VAR
  1547.     r : rect;
  1548.     p1, p2 : point;
  1549.     oldpenstate: penstate;
  1550. begin
  1551.     getpenstate(oldpenstate);
  1552.     move(-1,-1);
  1553.     pensize(2,2);
  1554.     line(0,0);
  1555.     setPenstate(oldpenstate);
  1556.     drawchar(' ');
  1557. end;
  1558.  
  1559. PROCEDURE dot;
  1560. BEGIN
  1561.     moveto(h, v);
  1562.     dothere;
  1563. END;
  1564.  
  1565.  
  1566. PROCEDURE dot2dR;
  1567. BEGIN
  1568.     moveto2dR(x, y);
  1569.     dothere;
  1570. END;
  1571.  
  1572.  
  1573. PROCEDURE sel2dRwind;
  1574. BEGIN
  1575.     setport2dR(port);
  1576.     selectwindow(windowptr(port^.gport));
  1577.     showwindow(windowptr(port^.gport));
  1578. END;
  1579.  
  1580. { W i n d o w -- 
  1581. for other possibilities, see the Window Manager chapter in Inside Macintosh}
  1582.  
  1583. CONST
  1584.          {version codes -- for internal use}
  1585.         cVsTxFrame = 1;
  1586.         
  1587.     FUNCTION newSubFrame;
  1588.         VAR
  1589.             bounds : rect;
  1590.             mypeek : windowpeek;
  1591.             mywindow : windowptr;
  1592.             myG2dRPtr : port2dRptr;
  1593.             testpt : point;
  1594.             scr, pos : integer;
  1595.             xList : TxList;
  1596.             xListP : TxPtr;
  1597.             xFrame : FramePtr;
  1598.             bigFrame : txFrame;
  1599.     BEGIN
  1600.         setFrame(bigFrameP); {create a default Graf2dR port}
  1601.         new(myG2dRPtr);
  1602.         open2dRPort(myG2dRPtr);
  1603.         bigFrame := bigFrameP^;
  1604.        {we are the only frame}
  1605.         new(xFrame);
  1606.         WITH xFrame^ DO
  1607.             BEGIN
  1608.                 fWindow := bigFrame.fWindow;
  1609.                 fID := cVsTxFrame;
  1610.                 fContainer := BigFrameP;
  1611.                 fContentRect := FrameRect;
  1612.                 
  1613.                 fFrameList := NIL;
  1614.                 fFrameType := FrameType;
  1615.                 f2dRPort := MyG2dRPtr;
  1616.                 fPicture := NIL;
  1617.             END;
  1618. {insert to list in bigframe}
  1619.         new(xlistP);
  1620.  
  1621.         WITH xlistP^ DO
  1622.             BEGIN
  1623.                 info := xframe;
  1624.                 next := bigframe.fFrameList;
  1625.             END;
  1626.         bigframeP^.fFrameList := xlistP;
  1627.  
  1628.         newSubFrame := xFrame;
  1629.     END;
  1630.  
  1631.  
  1632.     PROCEDURE setframe;
  1633.         VAR
  1634.             r : rect;
  1635.     BEGIN
  1636.         gTheFrame := aFrame;
  1637.         WITH aFrame^ DO
  1638.             BEGIN
  1639.                 IF g2dRFrame IN fFrameType THEN
  1640.                     setPort2dR(f2dRPort)
  1641.                 ELSE
  1642.                     setPort(fPort);
  1643.                         {we are in the container's port now. clip to 2dR port}
  1644.                 setorigin(-fContentRect.left, -fContentRect.top);
  1645.                 r := fContentRect;
  1646.                 OffsetRect(r, -fContentRect.left, -fContentRect.top);
  1647.                 cliprect(r);
  1648.             END;
  1649.     END;
  1650.  
  1651.     PROCEDURE makeawindow;
  1652.     {Generate a new window at default position}
  1653.  
  1654.         CONST
  1655.             xmaxpos = 16;
  1656.             ymaxpos = 11;
  1657.             offset = 20;
  1658.             delx = 5;
  1659.             dely = 45;
  1660.  
  1661.         VAR
  1662.             bounds : rect;
  1663.             mywindow : windowptr;
  1664.             myG2dRPtr : port2dRptr;
  1665.             testpt : point;
  1666.             scr, pos : integer;
  1667.             xList : TxList;
  1668.             xFrame : FramePtr;
  1669.             
  1670.     FUNCTION NewCWindow(wStorage: Ptr; boundsRect: Rect; title: Str255;
  1671.                     visible: BOOLEAN; procID: INTEGER; behind: WindowPtr;
  1672.                     goAwayFlag: BOOLEAN; refCon: LONGINT): WindowPtr;
  1673.     INLINE $AA45;
  1674.  
  1675.     BEGIN
  1676.         testpt.h := offset + delx;  {topleft windowposition free ?}
  1677.         testpt.v := offset + dely;
  1678.         scr := findWindow(testpt, mywindow);
  1679.         WITH system DO
  1680.             BEGIN
  1681.                 IF (myWindow = NIL) OR (WindowCount < 0) THEN
  1682.                     WindowCount := 0; {If no window in home position:take it}
  1683.                 WindowCount := succ(WindowCount);
  1684.                 pos := WindowCount;
  1685.             END;
  1686.         WITH bounds DO
  1687.             BEGIN
  1688.                 left := pos MOD xmaxpos * offset + delx;
  1689.                 top := pos MOD ymaxpos * offset + dely;
  1690.                 IF NOT PtInRect(topleft, System.DragRect) THEN
  1691.                     topleft := System.DragRect.topleft;
  1692.                 right := left + width;
  1693.                 bottom := top + height;
  1694.             END;
  1695.             if system.graficmodel=ColorQuickDrawModel then
  1696.         mywindow := 
  1697.         newCwindow(NIL, bounds, title, true, 
  1698.                 abs(windowDefId), pointer(-1), 
  1699.                 (windowDefId>=0), 0)
  1700.                 else     mywindow := 
  1701.         newwindow(NIL, bounds, title, true, 
  1702.                 abs(windowDefId), pointer(-1), 
  1703.                 (windowDefId>=0), 0);
  1704.     
  1705.         setport(mywindow);
  1706.     clipRect(thePort^.Portrect); {avoid dissipating pictures. see technote #59}
  1707.  
  1708.       {create a default Graf2dR port}
  1709.         new(myG2dRPtr);
  1710.         open2dRPort(myG2dRPtr);
  1711.  
  1712.        {we are the only frame}
  1713.         new(xFrame);
  1714.         WITH xFrame^ DO
  1715.             BEGIN
  1716.                 fWindow := MyWindow;
  1717.                 fID := cVsTxFrame;
  1718.                 fContainer := NIL;
  1719.                 fContentRect := theport^.portrect;
  1720.                 fFrameList := NIL;
  1721.                 fFrameType := [G2dRFrame];
  1722.                 f2dRPort := MyG2dRPtr;
  1723.                 fPicture := NIL;
  1724.             END;
  1725.  
  1726.         setwrefcon(mywindow, longint(xFrame));
  1727.  
  1728.         setFrame(xFrame);
  1729.  
  1730.     END;
  1731.  
  1732. procedure SetZoomOutSize (window:windowptr;h,v:integer);
  1733. {set the stdstate for a window}
  1734.  type
  1735.   wpp = ^wstatedata;
  1736.  var
  1737.   p: wpp;
  1738.  begin
  1739.   p := wpp(windowpeek(window)^.datahandle^);
  1740.   with p^.stdState do begin 
  1741.   {if larger than requested: trim}
  1742.        right:=left+h;
  1743.       if right>system.screenwidth then right:=system.screenwidth;
  1744.  
  1745.   bottom:=top+v;
  1746.   if bottom>system.screenheight then bottom:=system.screenheight
  1747.   end;
  1748.  end;
  1749.  
  1750.  
  1751. {userifc.ipl    implementations of usual features of the human interface}
  1752.  
  1753. {dialog & ctl tools }
  1754. PROCEDURE ItemCheckMark;
  1755. VAR    ItemType : Integer;
  1756.     ItemBox : Rect;
  1757.     ItemHdl : Handle;
  1758. BEGIN
  1759.     GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemBox);
  1760.     if ItemHdl<> nil then SetCtlValue(ControlHandle(ItemHdl), ChkMark);
  1761. END;
  1762.  
  1763.  
  1764. PROCEDURE ChkOnOffMItem(MenuHdl : MenuHandle;item, first, last : Integer);
  1765.     {set ITEM in menu checked and all else in first..last as unchecked}
  1766. VAR    i : integer;
  1767. BEGIN
  1768.     if MenuHdl<> nil then begin
  1769.     if first<1 then first:=1;
  1770.     i:=countMitems(MenuHdl);    if last>i then last:=i;
  1771.     FOR i := first TO last DO
  1772.         CheckItem(MenuHdl, i, (item=i)); {check it i on, others off in menu}
  1773.     end;
  1774. END;
  1775.  
  1776.  
  1777. FUNCTION GetOnOffMItem;
  1778.     {gets the first checked ITEM in menu. returns 0 if none is checked.}
  1779. VAR    index, loopindex : integer;
  1780.     markChar : char;
  1781. BEGIN
  1782.     if MenuHdl=nil then GetOnOffMItem:=0 else begin
  1783.     if first<1 then first:=1;
  1784.     index:=countMitems(MenuHdl);    if last>index then last:=index;
  1785.     index := 0;        loopindex := first;
  1786.     WHILE (loopindex <= last) AND (index = 0) DO
  1787.     BEGIN
  1788.         GetItemMark(MenuHdl, loopindex, markChar); {check it  in menu}
  1789.         IF markChar <> chr(0) THEN index := loopindex;
  1790.         loopindex := loopindex + 1;
  1791.     END;{while}
  1792.   GetOnOffMitem:=index;
  1793.   end;
  1794. END;
  1795.  
  1796.  
  1797. PROCEDURE PushRadioButton (theDlog : DialogPtr;item, first, last : integer);
  1798.     {set ITEM in menu checked and all else in first..last as unchecked}
  1799.  
  1800. VAR
  1801.     index : integer;        {index through the loop}
  1802.     itemtype : integer;        {the dialog items type}
  1803.     itemhandle : handle;        {the dialog items handle}
  1804.     itemrect : rect;        {the dialog items rect}
  1805. BEGIN
  1806.     FOR index := first TO last DO {do it for all items in the group}
  1807.     BEGIN
  1808.         GetDItem(theDlog, index, itemtype, itemhandle, itemrect); {get the handle}
  1809.         if itemhandle<>nil then begin
  1810.             IF (index = item) THEN
  1811.                 SetCtlValue(controlhandle(itemhandle), 1) {hilite the control}
  1812.             ELSE
  1813.             SetCtlValue(controlhandle(itemhandle), 0); {unlilite the control}
  1814.         end;
  1815.     END;
  1816. END;
  1817.  
  1818.  
  1819. FUNCTION GetRadioButton;
  1820.     {gets the first checked ITEM in dialog. returns 0 if none is checked.}
  1821.  
  1822. VAR
  1823.     loopindex, index : integer;         {index through the loop}
  1824.     itemtype : integer;        {the dialog items type}
  1825.     itemhandle : handle;        {the dialog items handle}
  1826.     itemrect : rect;        {the dialog items rect}
  1827. BEGIN
  1828.     index := 0;    loopindex := first;
  1829.     WHILE (loopindex <= last) AND (index = 0) DO
  1830.     BEGIN    {do it for all items in the group}
  1831.       GetDItem(theDlog, loopindex, itemtype, itemhandle, itemrect); {get the handle}
  1832.       if itemHandle<>nil then 
  1833.         IF GetCtlValue(controlhandle(itemhandle)) = 1 THEN
  1834.         index := loopindex; {hilited  control ?}
  1835.         loopindex := loopindex + 1;
  1836.     END;{while}
  1837.     getRadioButton := Index;
  1838. END;
  1839.  
  1840.  
  1841. PROCEDURE ItemSetText (TheDialog : dialogptr;ItemNo : integer;itext : str255);
  1842.     {set itext to static/edit/ctl item ItemNo}
  1843. VAR
  1844.     ItemType : Integer;
  1845.     ItemBox : Rect;
  1846.     ItemHdl : Handle;
  1847.     port : GrafPtr;
  1848. BEGIN
  1849.     GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemBox);
  1850.     ItemType := itemType MOD ItemDisable; {10. 9.86 hide Disable flag}
  1851.     hlock(handle(ItemHdl));
  1852.     IF ((itemtype = statText) OR (itemtype = editText)) THEN
  1853.     SetIText(ItemHdl, itext)
  1854.     ELSE IF itemType < statText THEN
  1855.     setctitle(ControlHandle(ItemHdl), itext);    {Noop for pictures etc.}
  1856.     hunlock(handle(ItemHdl));
  1857. END;
  1858.  
  1859.  
  1860.  
  1861. PROCEDURE ItemGetText (TheDialog : dialogptr;ItemNo : integer;VAR itext : str255);
  1862. VAR
  1863.     ItemType : Integer;
  1864.     ItemBox : Rect;
  1865.     ItemHdl : Handle;
  1866. BEGIN
  1867.     GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemBox);
  1868.     ItemType := itemType MOD ItemDisable; {10. 9.86 hide Disable flag}
  1869.     hlock(handle(ItemHdl));
  1870.     IF (itemtype = statText) OR (itemtype = editText) THEN
  1871.     GetIText(ItemHdl, itext)
  1872.     ELSE IF itemType < statText THEN
  1873.     getctitle(ControlHandle(ItemHdl), itext);
  1874.     {Noop for pictures etc.}
  1875.     hunlock(handle(ItemHdl));
  1876. END;
  1877.  
  1878. PROCEDURE FrameItem;
  1879. VAR
  1880.     ItemType : Integer;
  1881.     ItemBox : Rect;
  1882.     ItemHdl : Handle;
  1883.     oldPen : PenState;
  1884. BEGIN
  1885.     drawControls(WindowPtr(TheDialog));
  1886.     GetPenState(oldPen);
  1887.     PenNormal;
  1888.     PenSize(3, 3);
  1889.     GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemBox);
  1890.     InSetRect(ItemBox, -4, -4);
  1891.     FrameRoundRect(ItemBox, 16, 16);
  1892.     SetPenState(oldPen);
  1893. END;
  1894.  
  1895.  
  1896. FUNCTION ItemGetReal;
  1897. VAR    mstr : str255;
  1898. BEGIN
  1899.     ItemGetText(theDialog, ItemNo, mstr); ItemGetReal := str2Num(mstr);
  1900. END;
  1901.  
  1902. PROCEDURE ItemSetReal;
  1903. VAR    dstr : decstr;
  1904. BEGIN
  1905.     num2str(Form, value, dstr);    ItemSetText(theDialog, ItemNo, dstr);
  1906. END;
  1907.  
  1908. FUNCTION ItemGetNum;
  1909. VAR    dstr : str255;
  1910.     value : longint;
  1911. BEGIN
  1912.     ItemGetText(theDialog, ItemNo, dstr); stringToNum(dstr, value);
  1913.     ItemGetNum := value;
  1914. END;
  1915.  
  1916. PROCEDURE ItemSetNum;
  1917. VAR    dstr : str255;
  1918. BEGIN
  1919.     numToString(value, dstr);    ItemSetText(theDialog, ItemNo, dstr);
  1920. END;
  1921. {queue.ipl    implementation of an information-oriented queue}
  1922.  
  1923. procedure QueueInit{(var theStatus:  univ tQueueStatus)};
  1924.     {set all entries in theStatus to nil}
  1925. begin
  1926.     with theStatus do
  1927.     begin
  1928.         first:=nil;
  1929.         last:=nil;
  1930.         current:=nil;
  1931.     end;
  1932. end;
  1933.     
  1934. function AddPtr{(thePtr: univ Ptr;var theQueueStatus: univ tQueueStatus):osErr};
  1935.     {add the entry thePtr after Queue described by theQueueStatus}
  1936. var tempPtr:tQueuePtr;
  1937. begin
  1938.         new(tempPtr);
  1939.         if tempPtr=nil
  1940.          then AddPtr:=nilHandleErr {MemError}
  1941.         else begin
  1942.             AddPtr:=NoErr;
  1943.             with tempPtr^ do begin
  1944.                 infoPtr:=thePtr;
  1945.                 nextQElem:=nil;
  1946.             end;
  1947.             with theQueueStatus do
  1948.             begin
  1949.                 if first=nil then  first:=tempPtr;
  1950.                 if last<>nil then last^.nextQElem:=tempPtr;
  1951.                 last:=tempPtr;
  1952.             end;
  1953.         end;
  1954. end;
  1955.  
  1956. function nextinfoPtr{(var theQueueStatus: univ tQueueStatus):Ptr};
  1957.     {Get an entry from current position of Queue described by theQueueStatus.
  1958.     Advances pointer: first ... last .. nil.. first.. 
  1959.     Does  n o t  delete queue entry}
  1960. var tempPtr:tQueuePtr;
  1961.     tempElem:tQueueElem;
  1962. begin
  1963.     with theQueueStatus do
  1964.     begin
  1965.         if first=nil then  nextinfoPtr:=Nil
  1966.         else begin
  1967.             if current=nil then current:=first;
  1968.             nextinfoPtr:=current^.infoPtr;
  1969.             current:=current^.nextQElem;
  1970.         end;
  1971.     end;
  1972. end;
  1973.     
  1974. procedure DiscardPtr{(thePtr: univ Ptr;var theQueueStatus: univ tQueueStatus)};
  1975.     {Discard an entry from the Queue. Does  n o t  discard the info.
  1976.     Does nothing, if entry is not found. Advances Current, if necessary}
  1977. var tempPtr:tQueuePtr;
  1978.     tempMemory:tQueuePtr;
  1979.     tempElem:tQueueElem;
  1980. begin
  1981.     tempMemory:=nil;
  1982.     tempPtr:=theQueueStatus.first;
  1983.     while (tempPtr<>nil) and (tempPtr^.infoPtr<>thePtr) do
  1984.     begin    {try to find thePtr at info position}
  1985.         tempMemory:=tempPtr;
  1986.         tempPtr:=tempPtr^.nextQElem;
  1987.     end;
  1988.     if tempPtr<>nil then begin
  1989.         if tempMemory<>nil then {bridge links}
  1990.         tempMemory^.nextQElem:=tempPtr^.nextQElem;
  1991.         with theQueueStatus do begin {update the queue}
  1992.             if first=tempPtr then first:=tempPtr^.nextQElem;
  1993.             if current=tempPtr then current:=tempPtr^.nextQElem;
  1994.             if last=tempPtr then last:=tempMemory;
  1995.         end;    {with theQueueStatus}
  1996.         dispose(tempPtr);
  1997.     end;
  1998. end;
  1999.  
  2000. Procedure DiscardFirst{(var theQueueStatus: univ tQueueStatus)};
  2001.     {Special case: discard first entry in queue}
  2002. var tempPtr:tQueuePtr;
  2003. begin
  2004.     with theQueueStatus do begin
  2005.         if first<>nil then begin
  2006.             tempPtr:=first;
  2007.             if current=first then current:=first^.nextQElem;
  2008.             if last=first then current:=first^.nextQElem;
  2009.             first:=first^.nextQElem;
  2010.             dispose(tempPtr);
  2011.         end;
  2012.     end;
  2013. end;
  2014.  
  2015.  
  2016.  
  2017.     { M i s c a l l a n e o u s   R o u t i n e s}    
  2018.  
  2019.     { U n d o   s u p p o r t }
  2020.     
  2021. PROCEDURE ForgetUndo;
  2022. begin
  2023.     if gUndoHandle<>nil then begin
  2024.         ReleaseResource(gUndoHandle); {maybe it was a resource}
  2025.         if ResError<> noErr then disposHandle(gUndoHandle); {should be safer…}
  2026.     end;
  2027.     gUndoHandle:=nil;
  2028.     gUndoType:='    ';
  2029.     gUndoOwner:=Nil;
  2030.     gUndoAction:=cCantUndo;
  2031. end;
  2032.  
  2033. FUNCTION PutUndo{(info:handle;infoType:ResType;owner:ptr;cmd:cmdNumber):OsErr};
  2034.     {note the info for undo. makes a copy of info}
  2035. VAR MyErr:OsErr;
  2036. BEGIN
  2037.     ForgetUndo;
  2038.     gUndoHandle:=info;
  2039.     MyErr:=HandToHand(gUndoHandle);{make a copy of info and handle}
  2040.     if MyErr=NoErr then begin
  2041.         gUndoType:=infoType;
  2042.         gUndoOwner:=owner;
  2043.         gUndoAction:=cmd;
  2044.     END;
  2045.     PutUndo:=MyErr;
  2046. END;
  2047.  
  2048. FUNCTION GetUndo{(var info:handle;var infoType:ResType;
  2049.         var owner:ptr;var cmd:cmdNumber):OsErr};
  2050.         {returns a copy of the undo info, or NIL}
  2051. VAR MyErr:OsErr;
  2052. BEGIN
  2053.     info:=gUndoHandle;
  2054.     if info=nil then GetUndo:= noTypeErr else begin
  2055.         MyErr:=HandToHand(info);{make a copy of info and handle}
  2056.         if MyErr=NoErr then 
  2057.         begin
  2058.             infoType:=gUndoType;
  2059.             owner:=gUndoOwner;
  2060.             cmd:=gUndoAction;
  2061.         END 
  2062.         Else info:=nil;
  2063.         GetUndo:=MyErr;
  2064.     end;    {info available}
  2065. END;
  2066.  
  2067.  
  2068.         {  s t r i n g    s u p p o r t  }
  2069.         
  2070.         
  2071.     {function lefttrim (s : str255) : str255;}
  2072. FUNCTION lefttrim;
  2073. VAR        i, j : integer;
  2074. BEGIN
  2075.     j := length(s);
  2076.     IF j = 0 THEN    lefttrim := ''
  2077.     ELSE BEGIN
  2078.         i := 0;
  2079.         REPEAT i := succ(i) UNTIL (i = j) OR ((s[i] <> ' ') and (ord(s[i])<>9));
  2080.         IF ((s[i] <> ' ') and (ord(s[i])<>9))
  2081.             THEN lefttrim := copy(s, i, j - i + 1)
  2082.         ELSE lefttrim := '';
  2083.     END;
  2084. END;{lefttrim}
  2085.  
  2086. {function righttrim (s : str255) : str255;}
  2087. FUNCTION righttrim;
  2088. VAR
  2089.     i, j : integer;
  2090. BEGIN j := length(s);
  2091.     IF j = 0 THEN righttrim := '' ELSE
  2092.     BEGIN
  2093.         i := j + 1;
  2094.         REPEAT
  2095.             i := pred(i)
  2096.         UNTIL (i = 1) OR ((s[i] <> ' ') and (ord(s[i])<>9));
  2097.         IF ((s[i] <> ' ') and (ord(s[i])<>9))
  2098.             THEN righttrim := copy(s, 1, i) else righttrim := '';
  2099.     END;
  2100. END;{righttrim}
  2101.  
  2102.  
  2103.             { u s e r   i n t e r r u p t }
  2104.             
  2105. {check for apple dot. Horst Degen, 15.12.85}
  2106. FUNCTION PAbortFlag;
  2107. VAR
  2108.     myQElemPtr : QElemPtr;
  2109.     aChar : Char;
  2110.     myQHdrP : QHdrPtr;
  2111. BEGIN
  2112.     PAbortFlag := false;
  2113.     myQHdrP := GetEvQHdr;
  2114.     myQElemPtr := myQHdrP^.qHead;
  2115.     WHILE myQElemPtr <> NIL DO
  2116.     BEGIN
  2117.         IF myQElemPtr^.evQElem.evtQwhat = keydown THEN
  2118.         BEGIN
  2119.             aChar := CHR(BitAnd(myQElemPtr^.evQElem.evtQmessage, charCodeMask));
  2120. IF (aChar = '.') AND (BitAnd(myQElemPtr^.evQElem.evtQmodifiers, cmdKey) <> 0) THEN
  2121.             BEGIN
  2122.                 PAbortFlag := True;
  2123.                 myQElemPtr := NIL;
  2124.             END;
  2125.         END;
  2126.         IF myQElemPtr <> NIL THEN
  2127.         myQElemPtr := myQElemPtr^.evQElem.qlink;
  2128.     END;
  2129. END;
  2130.  
  2131.  
  2132.     { p r o g r e s s    r e p o r t }    
  2133.     
  2134. PROCEDURE showprogress;
  2135. BEGIN
  2136.     IF progressdialog <> NIL THEN
  2137.     BEGIN    showHide(windowptr(progressdialog), True);
  2138.         Drawdialog(progressdialog);
  2139.     END;
  2140. END;
  2141.  
  2142. PROCEDURE progressreport;
  2143. BEGIN
  2144.     IF progressdialog <> NIL THEN
  2145.     BEGIN
  2146.         showHide(windowptr(progressdialog), True);
  2147.         selectwindow(windowptr(progressdialog));
  2148.         ItemSetText(ProgressDialog, item + 1, what);
  2149.         systemtask;
  2150.     END;
  2151. END;
  2152.  
  2153. PROCEDURE hideprogress;
  2154. VAR
  2155.     i : integer;
  2156. BEGIN
  2157.     IF progressdialog <> NIL THEN
  2158.     BEGIN
  2159.         FOR i := 1 TO 4 DO
  2160.         ItemSetText(ProgressDialog, i + 1, '');
  2161.         showHide(windowptr(progressdialog), False);
  2162.     END;
  2163. END;
  2164.  
  2165.  
  2166.     { M I S C A L L A N E O U S }
  2167.     
  2168.     
  2169. PROCEDURE idstamp {(user : str255; VAR stampstring : str255)};
  2170.     {gives a standard identification string in stampstring.
  2171.         stampstring is build from USER and the current time information.}
  2172. CONST
  2173.     usrlen = 3;
  2174. VAR
  2175.     now : DateTimeRec;
  2176.     build, buildhex : str255;
  2177. FUNCTION cxhex (par : longint) : char;
  2178. VAR
  2179.     tpar : integer;
  2180. BEGIN
  2181.     tpar := abs(par MOD 34);
  2182.     IF tpar < 10 THEN
  2183.     cxhex := chr(tpar + ord('0'))
  2184.     ELSE
  2185.     cxhex := chr(tpar - 10 + ord('A'));
  2186. END; {cxhex}
  2187.  
  2188.  
  2189. PROCEDURE hexstr (par : longint; VAR tostr : str255);
  2190.     { par -> toStr, Laenge nrlen }
  2191. VAR
  2192.     rest : longint;
  2193.     i : integer;
  2194. BEGIN
  2195.     tostr := '    ';
  2196.     rest := par;
  2197.     IF rest < 0 THEN
  2198.     rest := abs(rest) - 1;
  2199.     FOR i := length(tostr) DOWNTO 1 DO
  2200.     BEGIN
  2201.         tostr[i] := cxhex(rest MOD 16);
  2202.         rest := rest DIV 16;
  2203.     END;
  2204. END;{hexstr}
  2205.  
  2206. BEGIN {idstamp}
  2207.     stampstring := user;
  2208.     delete(stampstring, usrlen + 1, 255);
  2209.     getTime(now);
  2210.     WITH now DO
  2211.     BEGIN
  2212.         build := '    ';
  2213.         build[1] := cxhex(year - 1980);
  2214.         build[2] := cxhex(month);
  2215.         build[3] := cxhex(day DIV 10);
  2216.         build[4] := cxhex(day MOD 10);
  2217.  
  2218.         hexstr(minute * 60 + second, buildhex);
  2219.         buildhex[1] := cxhex(hour);
  2220.     END;
  2221.     stampstring := concat(stampstring, ' ', build, ' ', buildhex);
  2222. END;{idstamp}
  2223.  
  2224.  
  2225.     { C l e a r   P i c / S e t   W i n d o w }
  2226.     
  2227. {clear the picture associated to a window}
  2228. PROCEDURE clearwindow;
  2229. VAR
  2230.     r : rect;
  2231.     pic : pichandle;
  2232.     s : str255;
  2233. BEGIN
  2234.     pic := getwindowpic(window);
  2235.     IF pic <> NIL THEN
  2236.     BEGIN
  2237.         setwindowpic(window, NIL);
  2238.         killpicture(pic);
  2239.     END;
  2240.     setport(window);
  2241.     eraserect(theport^.portrect);
  2242.     validrect(theport^.portrect);
  2243. END;
  2244.  
  2245.  
  2246. PROCEDURE setwport;
  2247. BEGIN
  2248.     setport(window);
  2249.     selectwindow(window);
  2250.     showwindow(window);
  2251. END;
  2252.  
  2253.  
  2254. End.
  2255.